home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 6 / Amiga Format AFCD06 (Nov 1996, Issue 90).iso / serious / commercial / cloanto / colortype / rexx / fonttexts.ctrx < prev    next >
Text File  |  1996-04-11  |  2KB  |  101 lines
  1. /* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: FontTexts.ctrx 1.0 */
  4.  
  5. /**
  6.  This script creates an IFF-ILBM image file for each font in the specified
  7.  path. The images contain a short text sample, consisting of the font's name
  8.  and size.
  9. */
  10.  
  11. IF ARG(1, EXISTS) THEN
  12.     PARSE ARG CTPORT
  13. ELSE
  14.     CTPORT = 'COLORTYPE'
  15.  
  16. IF ~SHOW('P', CTPORT) THEN DO
  17.     IF EXISTS('ColorType:ColorType') THEN DO
  18.         ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
  19.         DO 30 WHILE ~SHOW('P',CTPORT)
  20.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  21.         END
  22.     END
  23.     ELSE DO
  24.         SAY "ColorType could not be loaded."
  25.         EXIT 10
  26.     END
  27. END
  28.  
  29. IF ~SHOW('P', CTPORT) THEN DO
  30.     SAY 'ColorType Rexx port could not be opened.'
  31.     EXIT 10
  32. END
  33.  
  34. ADDRESS VALUE CTPORT
  35. OPTIONS RESULTS
  36. OPTIONS FAILAT 10000
  37.  
  38.  
  39. LockGUI
  40. RequestFont '"Select the Font Path"'
  41. IF RC = 0 THEN DO
  42.     PARSE VALUE RESULT WITH '"' font_path '"'
  43.     RequestPath '"Select the Image Path"'
  44.     IF RC = 0 THEN DO
  45.         PARSE VALUE RESULT WITH '"' image_path '"'
  46.         NewFont
  47.         IF RC = 0 THEN DO
  48.             ListFonts '"'font_path'"'
  49.             IF RC = 0 THEN DO
  50.                 fontlist = RESULT
  51.                 tmpfname = 'T:ctrx_temp.'PRAGMA('ID')
  52.                 IF OPEN('listfile', tmpfname, W) THEN DO
  53.                     WRITECH('listfile', fontlist)
  54.                     CALL CLOSE('listfile')
  55.                     IF OPEN('listfile', tmpfname, R) THEN DO
  56.                         errcode = 0
  57.                         DO FOREVER
  58.                             curfont = READLN('listfile')
  59.                             IF EOF('listfile') THEN BREAK
  60.                             LoadFont FORCE '"'font_path'"' NAME curfont
  61.                             IF RC = 0 THEN DO
  62.                                 PARSE VALUE curfont WITH '"' fontname '"' fontsize fontstyle .
  63.                                 imgname = image_path
  64.                                 IF RIGHT(image_path,1) ~= ':' THEN
  65.                                     imgname = imgname || '/'
  66.                                 imgname = imgname || fontname'_'fontsize
  67.                                 IF LENGTH(fontstyle) ~= 0 THEN
  68.                                     imgname = imgname'_'fontstyle
  69.                                 DynamicView '"'fontname fontsize'"'
  70.                                 SaveDView '"'imgname'.pic"'
  71.                                 IF RC ~= 0 THEN DO
  72.                                     errcode = RC
  73.                                     IF RC = 5 THEN
  74.                                         errmess = 'User abort during save.'
  75.                                     ELSE
  76.                                         errmess = 'Error 'RC' during save.'
  77.                                 END
  78.                             END
  79.                             ELSE DO
  80.                                 errcode = RC
  81.                                 IF RC = 5 THEN
  82.                                     errmess = 'User abort during load.'
  83.                                 ELSE
  84.                                     errmess = 'Error 'RC' during load.'
  85.                             END
  86.                         END
  87.                         CALL CLOSE('listfile')
  88.  
  89.                         IF errcode > 0 THEN DO
  90.                             SAY errmess
  91.                             RequestNotify 'PROMPT="'errmess'"'
  92.                         END
  93.                     END
  94.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  95.                 END
  96.             END
  97.         END
  98.     END
  99. END
  100. UnlockGUI
  101.